home *** CD-ROM | disk | FTP | other *** search
-
- (define test >=)
-
- (define (qsort! v m n)
- (define (interchange i j)
- (let ((t (vector-ref v i)))
- (vector-set! v i (vector-ref v j))
- (vector-set! v j t)))
- (define (qsort-i m n)
- (if (< m n)
- (do ((i m)
- (j (1+ n))
- (k (vector-ref v m)))
- ((>= i j) (interchange m j)
- (qsort-i m (-1+ j))
- (qsort-i (1+ j) n))
- (set! i (1+ i))
- (do () ((or (test (vector-ref v i) k) (>= i n)))
- (set! i (1+ i)))
- (set! j (-1+ j))
- (do () ((or (test k (vector-ref v j)) (<= j m)))
- (set! j (-1+ j)))
- (if (< i j)
- (interchange i j)))))
- (qsort-i m n))
-